Revolution - Das Atari CD Magazin 1997/Revolution - Das Atari CD Magazin 1.iso/software/progtool/olga/olga.lzh/source/OLGA.PAS

Pascal/Delphi Source File | 1996-11-20 | 47KB | 2,114 lines

{***************************************
 * Object Linking for GEM Applications *
 *       written by Thomas Much        *
 ***************************************
 *      O L G A - M a n a g e r        *
 *   Dieses Programm ist Freeware!     *
 ***************************************
 *    Thomas Much, Gerwigstraße 46,    *
 * 76131 Karlsruhe, Fax [phone]  *
 *         Thomas Much @ KA2           *
 *  [e-mail]  *
 ***************************************
 *    erstellt am:        07.03.1995   *
 *    letztes Update am:  20.11.1996   *
 ***************************************}

{$IFDEF DEBUG}
    {$B+,D+,G-,I-,L+,N-,P-,Q+,R+,S+,T-,V-,X+,Z-}
{$ELSE}
    {$B+,D-,G-,I-,L-,N-,P-,Q-,R-,S-,T-,V-,X+,Z-}
{$ENDIF}

{$M 16384}

program OLGA;

uses

    Strings,Dos,Tos,Gem;

const

    OLGAVersion      = $0120;
    OLGAVersionStr   = '1.20';
    OLGARevision     = '1.2';
    OLGADate         = '20.11.96';
    OLGAProtocol     = 0;

    {$I OLGA.INC}

const

    OLGAFlags        = OL_MANAGER or OL_START or OL_IDLE;
    CMDMAX           =     9;
    SIGQUIT          =     3;
    SIGTERM          =    15;
    CH_EXIT          =    90;
    WF_WINX          = 22360;
    AV_SENDKEY       = $4710;
    VA_START         = $4711;
    AV_PATH_UPDATE   = $4730;
    GLOBAL           =   $20;
    _p_cookies       =  $5a0;
    _bootdev         =  $446;

type

    PLongint = ^longint;
    PWord    = ^word;

    PCookie = ^TCookie;
    TCookie = record
        ID:  array[0..3] of char;
        Val: longint
    end;

    PLink = ^TLink;
    TLink = record
        apID,
        Group: integer;
        Path : pointer;
        Prev,
        Next : PLink
    end;

    PDocument = ^TDocument;
    TDocument = record
        apID,
        Group: integer;
        Prev,
        Next : PDocument
    end;

    PNote = ^TNote;
    TNote = record
        apID,
        ext4,
        ext5: integer;
        Prev,
        Next: PNote
    end;

    PClient = ^TClient;
    TClient = record
        srvID,
        clID : integer;
        Prev,
        Next : PClient
    end;

    PServer = ^TServer;
    TServer = record
        clID,
        srvID,
        ext4,
        ext5 : integer;
        Prev,
        Next : PServer
    end;

    PObject = ^TObject;
    TObject = record
        ext4,
        ext5 : integer;
        descr: pointer;
        next : PObject
    end;

    PApp = ^TApp;
    TApp = record
        apID,
        Protocol,
        ipaProtocol,
        Flags,
        XAccType,
        CmdCount   : integer;
        CmdLen     : array [0..CMDMAX] of integer;
        StartCmd   : array [0..CMDMAX] of pointer;
        enumOLE    : PObject;
        Prev,
        Next       : PApp
    end;

    PType = ^TType;
    TType = record
        typ : integer;
        path: string;
        next: PType
    end;

    PExtension = ^TExtension;
    TExtension = record
        ext4,
        ext5: integer;
        path: string;
        next: PExtension
    end;

    PAlias = ^TAlias;
    TAlias = record
        alias,
        path : string;
        next : PAlias
    end;

    PAESVARS = ^AESVARS;
    AESVARS  = record
        magic      : longint;
        membot,
        aes_start  : pointer;
        magic2     : array [0..3] of char;
        date       : longint;
        chgres,
        shel_vector,
        aes_bootdrv,
        vdi_device : pointer;
        reservd1,
        reservd2,
        reservd3   : pointer;
        version,
        release    : integer
    end;

    PMAGX_COOKIE = ^MAGX_COOKIE;
    MAGX_COOKIE  = record
        config_status: longint;
        dos_vars     : pointer;
        aes_vars     : PAESVARS
    end;

var

    apID,
    menuID,
    LinkCount,
    AppCount,
    DocCount     : integer;
    termflag,
    MultiTOS,
    Multitask,
    MemProt,
    MagiX,
    has_agi,
    mbar         : boolean;
    empty        : pointer;
    Apps         : PApp;
    Links        : PLink;
    Docs         : PDocument;
    Aliases      : PAlias;
    Types        : PType;
    Notes        : PNote;
    Server       : PServer;
    Clients      : PClient;
    Objects      : PObject;
    Extensions   : PExtension;
    apName       : PChar;



function HeapFunc(size: longint): integer;

  begin
    HeapFunc:=1
  end;


procedure SigHandler(dummy1,dummy2,sig: pointer);

    begin
        termflag:=true
    end;


function bootdev: longint;

    begin
        bootdev:=PWord(_bootdev)^+65
    end;


function ltoa(x: longint): string;
    var dummy: string;

    begin
        str(x,dummy);
        ltoa:=dummy
    end;


function StrPPas(p: PChar): string;

    begin
        if p=nil then StrPPas:=''
        else
            StrPPas:=StrPas(p)
    end;


function Ptr(hi,lo: word): pointer;

    begin
        Ptr:=pointer(longint(hi)*longint(65536)+longint(lo))
    end;


function HiWord(p: pointer): word;

    begin
        HiWord:=word(longint(p) div 65536)
    end;


function LoWord(p: pointer): word;

    begin
        LoWord:=word(longint(p) mod 65536)
    end;


function bTst(value,mask: longint): boolean;

    begin
        bTst:=((value and mask)=mask)
    end;


procedure GlobalAlloc(var p: pointer; size: longint);

    begin
        if MemProt then p:=mxalloc(size,GLOBAL)
        else
            getmem(p,size)
    end;


procedure GlobalFree(var p: pointer; size: longint);

    begin
        if p=nil then exit;
        if not(MemProt) then
            begin
                freemem(p,size);
                p:=nil
            end
        else
            if mfree(p)=0 then p:=nil
    end;


function ExpandPath(s: string): string;
    var pal: PAlias;

    begin
        if length(s)>0 then
            if s[1]='$' then
                begin
                    s:=copy(s,2,length(s)-1);
                    pal:=Aliases;
                    while pal<>nil do
                        begin
                            if s=pal^.alias then
                                begin
                                    ExpandPath:=ExpandPath(pal^.path);
                                    exit
                                end;
                            pal:=pal^.next
                        end;
                    s:=''
                end;
        ExpandPath:=s
    end;


procedure OpenDoc(const pipe: ARRAY_8);
    var pdoc,pdocd: PDocument;

    begin
        new(pdoc);
        if pdoc<>nil then
            begin
                pdoc^.apID:=pipe[1];
                pdoc^.Group:=pipe[5];
                pdoc^.Prev:=nil;
                pdoc^.Next:=nil;
                if Docs=nil then Docs:=pdoc
                else
                    begin
                        pdocd:=Docs;
                        while pdocd^.Next<>nil do pdocd:=pdocd^.Next;
                        pdocd^.Next:=pdoc;
                        pdoc^.Prev:=pdocd
                    end;
                inc(DocCount)
            end
    end;


procedure Denotify(orgID,e4,e5: integer);
    label _nochmal;

    var pn: PNote;

    begin
        _nochmal:
        pn:=Notes;
        while pn<>nil do
            begin
                if orgID=pn^.apID then
                    if ((e4=pn^.ext4) and (e5=pn^.ext5)) or ((e4=0) and (e5=0)) then
                        begin
                            if (pn^.Prev=nil) and (pn^.Next=nil) then Notes:=nil
                            else
                                begin
                                    if pn^.Prev=nil then Notes:=pn^.Next
                                    else
                                        pn^.Prev^.Next:=pn^.Next;
                                    if pn^.Next<>nil then pn^.Next^.Prev:=pn^.Prev
                                end;
                            dispose(pn);
                            goto _nochmal
                        end;
                pn:=pn^.Next
            end
    end;


function Unlink(pv,gv: boolean; const pipe: ARRAY_8): integer;
    label _unlink,_weiter;

    var pc : PChar;
        pld: PLink;
        ret: integer;

    begin
        if pv then pc:=PChar(Ptr(word(pipe[3]),word(pipe[4])));
        Unlink:=0;
        ret:=0;
        _unlink:
        pld:=Links;
        while pld<>nil do
            with pld^ do
                begin
                    if apID=pipe[1] then
                        begin
                            if gv then
                                if Group<>pipe[5] then goto _weiter;
                            if pv then
                                if StrIComp(pc,Path)<>0 then goto _weiter;
                            GlobalFree(Path,StrLen(Path)+1);
                            if (Prev=nil) and (Next=nil) then Links:=nil
                            else
                                begin
                                    if Prev=nil then Links:=Next
                                    else
                                        Prev^.Next:=Next;
                                    if Next<>nil then Next^.Prev:=Prev
                                end;
                            dispose(pld);
                            dec(LinkCount);
                            if pv then
                                begin
                                    inc(ret);
                                    Unlink:=ret
                                end;
                            goto _unlink
                        end;
                    _weiter:
                    pld:=Next
                end
    end;


procedure CloseDoc(gv: boolean; const pipe: ARRAY_8);
    label _closedoc,_weiter;

    var pdocd: PDocument;

    begin
        _closedoc:
        pdocd:=Docs;
        while pdocd<>nil do
            with pdocd^ do
                begin
                    if apID=pipe[1] then
                        begin
                            if gv then
                                if Group<>pipe[5] then goto _weiter;
                            if (Prev=nil) and (Next=nil) then Docs:=nil
                            else
                                begin
                                    if Prev=nil then Docs:=Next
                                    else
                                        Prev^.Next:=Next;
                                    if Next<>nil then Next^.Prev:=Prev
                                end;
                            dispose(pdocd);
                            dec(DocCount);
                            goto _closedoc
                        end;
                    _weiter:
                    pdocd:=Next
                end
    end;


function ShelWrite(mode,wisgr,wiscr: integer; cmd,tail: pointer): integer;

    begin
        with AES_pb do
            begin
                control^[0]:=121;
                control^[1]:=3;
                control^[2]:=1;
                control^[3]:=2;
                control^[4]:=0;
                intin^[0]:=mode;
                intin^[1]:=wisgr;
                intin^[2]:=wiscr;
                addrin^[0]:=cmd;
                addrin^[1]:=tail;
                _crystal(@AES_pb);
                if intout^[0]<>0 then ShelWrite:=1
                else
                    ShelWrite:=0
            end
    end;


function appl_xgetinfo(ap_gtype: integer; var ap_gout1,ap_gout2,ap_gout3,ap_gout4: integer): boolean;

    begin
        appl_xgetinfo:=false;
        if has_agi then
            with AES_pb do
                begin
                    control^[0]:=130;
                    control^[1]:=1;
                    control^[2]:=5;
                    control^[3]:=0;
                    control^[4]:=0;
                    intin^[0]:=ap_gtype;
                    _crystal(@AES_pb);
                    if intout^[0]=1 then
                        begin
                            ap_gout1:=intout^[1];
                            ap_gout2:=intout^[2];
                            ap_gout3:=intout^[3];
                            ap_gout4:=intout^[4];
                            appl_xgetinfo:=true
                        end
                end
    end;


function getjar: longint;

    begin
        getjar:=PLongint(_p_cookies)^
    end;


procedure ServerStarted(srvID,clID,ext4,ext5: integer);
    var ps,psd: PServer;
        pc,pcd: PClient;
        found : boolean;

    begin
        ps:=Server;
        found:=false;
        while ps<>nil do
            begin
                if clID=ps^.clID then
                    if srvID=ps^.srvID then
                        if (ext4=ps^.ext4) and (ext5=ps^.ext5) then
                            begin
                                found:=true;
                                break
                            end;
                ps:=ps^.Next;
            end;
        if not(found) then
            begin
                new(ps);
                if ps<>nil then
                    begin
                        ps^.clID:=clID;
                        ps^.srvID:=srvID;
                        ps^.ext4:=ext4;
                        ps^.ext5:=ext5;
                        ps^.Prev:=nil;
                        ps^.Next:=nil;
                        if Server=nil then Server:=ps
                        else
                            begin
                                psd:=Server;
                                while psd^.Next<>nil do psd:=psd^.Next;
                                psd^.Next:=ps;
                                ps^.Prev:=psd
                            end
                    end
            end;
        pc:=Clients;
        found:=false;
        while pc<>nil do
            begin
                if pc^.srvID=srvID then
                    if pc^.clID=clID then
                        begin
                            found:=true;
                            break
                        end;
                pc:=pc^.Next
            end;
        if not(found) then
            begin
                new(pc);
                if pc<>nil then
                    begin
                        pc^.srvID:=srvID;
                        pc^.clID:=clID;
                        pc^.Prev:=nil;
                        pc^.Next:=nil;
                        if Clients=nil then Clients:=pc
                        else
                            begin
                                pcd:=Clients;
                                while pcd^.Next<>nil do pcd:=pcd^.Next;
                                pcd^.Next:=pc;
                                pc^.Prev:=pcd
                            end
                    end
            end
    end;


procedure ClientTerminated(clID: integer);
    label _nochmal;

    var answ  : ARRAY_8;
        pc,pcd: PClient;

    begin
        answ[0]:=OLGA_CLIENTTERMINATED;
        answ[1]:=apID;
        answ[2]:=0;
        answ[3]:=clID;
        answ[5]:=0;
        answ[6]:=0;
        answ[7]:=0;
        _nochmal:
        pc:=Clients;
        while pc<>nil do
            begin
                if pc^.clID=clID then
                    begin
                        answ[4]:=0;
                        pcd:=Clients;
                        while pcd<>nil do
                            begin
                                if pcd<>pc then
                                    if pcd^.srvID=pc^.srvID then inc(answ[4]);
                                pcd:=pcd^.Next
                            end;
                        appl_write(pc^.srvID,16,@answ);
                        if (pc^.Prev=nil) and (pc^.Next=nil) then Clients:=nil
                        else
                            begin
                                if pc^.Prev=nil then Clients:=pc^.Next
                                else
                                    pc^.Prev^.Next:=pc^.Next;
                                if pc^.Next<>nil then pc^.Next^.Prev:=pc^.Prev
                            end;
                        dispose(pc);
                        goto _nochmal
                    end
                else
                    if pc^.srvID=clID then
                        begin
                            if (pc^.Prev=nil) and (pc^.Next=nil) then Clients:=nil
                            else
                                begin
                                    if pc^.Prev=nil then Clients:=pc^.Next
                                    else
                                        pc^.Prev^.Next:=pc^.Next;
                                    if pc^.Next<>nil then pc^.Next^.Prev:=pc^.Prev
                                end;
                            dispose(pc);
                            goto _nochmal
                        end;
                pc:=pc^.Next
            end
    end;


procedure ServerTerminated(srvID,retCode: integer);
    label _nochmal;

    var ps  : PServer;
        answ: ARRAY_8;

    begin
        answ[0]:=OLGA_SERVERTERMINATED;
        answ[1]:=apID;
        answ[2]:=0;
        answ[3]:=srvID;
        answ[6]:=retCode;
        answ[7]:=0;
        _nochmal:
        ps:=Server;
        while ps<>nil do
            begin
                if ps^.srvID=srvID then
                    begin
                        answ[4]:=ps^.ext4;
                        answ[5]:=ps^.ext5;
                        appl_write(ps^.clID,16,@answ);
                        if (ps^.Prev=nil) and (ps^.Next=nil) then Server:=nil
                        else
                            begin
                                if ps^.Prev=nil then Server:=ps^.Next
                                else
                                    ps^.Prev^.Next:=ps^.Next;
                                if ps^.Next<>nil then ps^.Next^.Prev:=ps^.Prev
                            end;
                        dispose(ps);
                        goto _nochmal
                    end
                else
                    if ps^.clID=srvID then
                        begin
                            if (ps^.Prev=nil) and (ps^.Next=nil) then Server:=nil
                            else
                                begin
                                    if ps^.Prev=nil then Server:=ps^.Next
                                    else
                                        ps^.Prev^.Next:=ps^.Next;
                                    if ps^.Next<>nil then ps^.Next^.Prev:=ps^.Prev
                                end;
                            dispose(ps);
                            goto _nochmal
                        end;
                ps:=ps^.Next
            end
    end;


procedure OLEInit(const pipe: ARRAY_8);
    label _nooep;

    var answ  : ARRAY_8;
        pa,pad: PApp;
        i     : integer;

    begin
        {$IFDEF DEBUG}
        write('OLGA: OLE_INIT App ',pipe[1],'  ');
        if (pipe[3] and OL_SERVER)>0 then write('Server ');
        if (pipe[3] and OL_CLIENT)>0 then write('Client ');
        if (pipe[3] and OL_PIPES)>0 then write('Pipes ');
        write('Stufe ',pipe[4],'  OEP ',pipe[5],' ',pipe[6],'  ');
        writeln(chr(hi(pipe[7])),chr(lo(pipe[7])));
        {$ENDIF}
        if (pipe[3] and OL_PEER)=0 then
            begin
                answ[7]:=0;
                goto _nooep
            end;
        pa:=nil;
        pad:=Apps;
        while pad<>nil do
            begin
                if pad^.apID=pipe[1] then
                    begin
                        pa:=pad;
                        break
                    end;
                pad:=pad^.Next
            end;
        if pa=nil then
            begin
                new(pa);
                if pa<>nil then
                    begin
                        pa^.apID:=pipe[1];
                        pa^.CmdCount:=-1;
                        for i:=0 to CMDMAX do pa^.StartCmd[i]:=nil;
                        pa^.enumOLE:=nil;
                        pa^.ipaProtocol:=0;
                    pa^.Prev:=nil;
                    pa^.Next:=nil;
                        if Apps=nil then Apps:=pa
                        else
                            begin
                                pad:=Apps;
                                while pad^.Next<>nil do pad:=pad^.Next;
                                pad^.Next:=pa;
                                pa^.Prev:=pad
                            end;
                        inc(AppCount)
                    end
            end;
        if pa<>nil then
            begin
                pa^.Flags:=pipe[3];
                pa^.Protocol:=pipe[4];
                pa^.XAccType:=pipe[7];
                answ[7]:=1
            end
        else
            answ[7]:=0;
        _nooep:
        answ[0]:=OLGA_INIT;
        answ[1]:=apID;
        answ[2]:=0;
        answ[3]:=OLGAFlags;
        answ[4]:=OLGAProtocol;
        answ[5]:=0;
        answ[6]:=0;
        appl_write(pipe[1],16,@answ)
    end;


procedure OLEExit(const pipe: ARRAY_8);
    label _exit;

    var i     : integer;
        pa,pad: PApp;
        dummy : string;

    begin
        {$IFDEF DEBUG}
        writeln('OLGA: OLE_EXIT App ',pipe[1]);
        {$ENDIF}
        Denotify(pipe[1],0,0);
        Unlink(false,false,pipe);
        CloseDoc(false,pipe);
        ServerTerminated(pipe[1],0);
        ClientTerminated(pipe[1]);
        _exit:
        pad:=Apps;
        while pad<>nil do
            with pad^ do
                begin
                    if apID=pipe[1] then
                        begin
                            for i:=0 to CMDMAX do
                                if StartCmd[i]<>nil then GlobalFree(StartCmd[i],CmdLen[i]);
                            if (Prev=nil) and (Next=nil) then Apps:=nil
                            else
                                begin
                                    if Prev=nil then Apps:=Next
                                    else
                                        Prev^.Next:=Next;
                                    if Next<>nil then Next^.Prev:=Prev
                                end;
                            dispose(pad);
                            dec(AppCount);
                            goto _exit
                        end;
                    pad:=Next
                end;
        if AppCount=0 then
            if Multitask then
                if AppFlag then
                    if apName<>nil then
                        begin
                            dummy:=GetEnv('OLGAMANAGER')+#0;
                            if StrIComp(apName,@dummy[1])=0 then
                                begin
                                    {$IFDEF DEBUG}
                                    writeln('... OLGA deaktiviert.');
                                    {$ENDIF}
                                    appl_exit;
                                    halt
                                end
                        end
    end;


procedure OLGAUpdate(const pipe: ARRAY_8);
    var answ : ARRAY_8;
        p2   : pointer;
        pc,p1: PChar;
        pld  : PLink;
        pn   : PNote;
        e4,e5: integer;
        s    : string;

    begin
        {$IFDEF DEBUG}
        write('OLGA: OLGA_UPDATE App ',pipe[1],'  ');
        {$ENDIF}
        answ[0]:=OLGA_UPDATED;
        answ[1]:=apID;
        answ[2]:=0;
        answ[5]:=pipe[5];
        answ[6]:=pipe[1];
        pc:=PChar(Ptr(word(pipe[3]),word(pipe[4])));
        {$IFDEF DEBUG}
        writeln(pc,'  Info ',pipe[5]);
        {$ENDIF}
        pld:=Links;
        while pld<>nil do
            with pld^ do
                begin
                    if StrIComp(pc,Path)=0 then
                        begin
                            {$IFDEF DEBUG}
                            writeln('      Update an App ',apID,' Gruppe ',Group);
                            {$ENDIF}
                            answ[3]:=integer(HiWord(Path));
                            answ[4]:=integer(LoWord(Path));
                            answ[7]:=Group;
                            appl_write(apID,16,@answ)
                        end;
                    pld:=Next
                end;
        if Notes<>nil then
            begin
                p1:=StrRScan(pc,'.');
                p2:=StrRScan(pc,'\');
                if longint(p1)>longint(p2) then
                    begin
                        s:=StrPas(p1);
                        while length(s)<4 do s:=s+#0;
                        e4:=(ord(s[1]) shl 8) or ord(s[2]);
                        e5:=(ord(s[3]) shl 8) or ord(s[4])
                    end
                else
                    begin
                        e4:=0;
                        e5:=0
                    end;
                answ[0]:=OLGA_NOTIFY;
                answ[5]:=0;
                answ[6]:=0;
                answ[7]:=0;
                pn:=Notes;
                while pn<>nil do
                    begin
                        if ((e4=pn^.ext4) and (e5=pn^.ext5)) or ((pn^.ext4=0) and (pn^.ext5=0)) then
                            begin
                                {$IFDEF DEBUG}
                                writeln('      Notify an App ',pn^.apID);
                                {$ENDIF}
                                GlobalAlloc(p2,StrLen(pc)+1);
                                if p2<>nil then
                                    begin
                                        StrCopy(p2,pc);
                                        answ[3]:=integer(HiWord(p2));
                                        answ[4]:=integer(LoWord(p2));
                                        appl_write(pn^.apID,16,@answ)
                                    end
                            end;
                        pn:=pn^.Next
                    end
            end;
        answ[0]:=OLGA_ACK;
        answ[3]:=pipe[3];
        answ[4]:=pipe[4];
        answ[5]:=0;
        answ[6]:=0;
        answ[7]:=OLGA_UPDATE;
        appl_write(pipe[1],16,@answ)
    end;


procedure OLGARename(const pipe: ARRAY_8);
    var answ: ARRAY_8;
        pld : PLink;
        pc  : PChar;

    begin
        {$IFDEF DEBUG}
        writeln('OLGA: OLGA_RENAME App ',pipe[1],'  ',PChar(Ptr(word(pipe[3]),word(pipe[4]))),' -> ',PChar(Ptr(word(pipe[5]),word(pipe[6]))));
        {$ENDIF}
        pld:=Links;
        answ[0]:=OLGA_RENAMELINK;
        answ[1]:=apID;
        answ[2]:=0;
        answ[5]:=pipe[5];
        answ[6]:=pipe[6];
        pc:=PChar(Ptr(word(pipe[3]),word(pipe[4])));
        while pld<>nil do
            with pld^ do
                begin
                    if StrIComp(pc,Path)=0 then
                        begin
                            {$IFDEF DEBUG}
                            writeln('      RenameLink an App ',apID,' Gruppe ',Group);
                            {$ENDIF}
                            answ[3]:=integer(HiWord(Path));
                            answ[4]:=integer(LoWord(Path));
                            answ[7]:=Group;
                            appl_write(apID,16,@answ)
                        end;
                    pld:=Next
                end;
        answ[0]:=OLGA_ACK;
        answ[3]:=pipe[3];
        answ[4]:=pipe[4];
        answ[7]:=OLGA_RENAME;
        appl_write(pipe[1],16,@answ)
    end;


procedure OLGALinkRenamed(const pipe: ARRAY_8);
    var pld   : PLink;
        pc,pc2: PChar;
        p2    : pointer;

    begin
        {$IFDEF DEBUG}
        writeln('OLGA: OLGA_LINKRENAMED App ',pipe[1],' Gruppe ',pipe[7],'  ',PChar(Ptr(word(pipe[3]),word(pipe[4]))),' -> ',PChar(Ptr(word(pipe[5]),word(pipe[6]))));
        {$ENDIF}
        pld:=Links;
        pc:=PChar(Ptr(word(pipe[3]),word(pipe[4])));
        while pld<>nil do
            with pld^ do
                begin
                    if Group=pipe[7] then
                        if pc=Path then
                            begin
                                pc2:=PChar(Ptr(word(pipe[5]),word(pipe[6])));
                                GlobalAlloc(p2,StrLen(pc2)+1);
                                if p2<>nil then
                                    begin
                                        StrCopy(p2,pc2);
                                        GlobalFree(Path,StrLen(Path)+1);
                                        Path:=p2
                                    end
                            end;
                    pld:=Next
                end
    end;


procedure OLGAOpenDoc(const pipe: ARRAY_8);
    var answ: ARRAY_8;

    begin
        {$IFDEF DEBUG}
        writeln('OLGA: OLGA_OPENDOC App ',pipe[1],' Gruppe ',pipe[5]);
        {$ENDIF}
        OpenDoc(pipe);
        answ[0]:=OLGA_ACK;
        answ[1]:=apID;
        answ[2]:=0;
        answ[3]:=0;
        answ[4]:=0;
        answ[5]:=pipe[5];
        answ[6]:=0;
        answ[7]:=OLGA_OPENDOC;
        appl_write(pipe[1],16,@answ)
    end;


procedure OLGACloseDoc(const pipe: ARRAY_8);
    var answ: ARRAY_8;

    begin
        {$IFDEF DEBUG}
        writeln('OLGA: OLGA_CLOSEDOC App ',pipe[1],' Gruppe ',pipe[5]);
        {$ENDIF}
        Unlink(false,true,pipe);
        CloseDoc(true,pipe);
        answ[0]:=OLGA_ACK;
        answ[1]:=apID;
        answ[2]:=0;
        answ[3]:=0;
        answ[4]:=0;
        answ[5]:=pipe[5];
        answ[6]:=0;
        answ[7]:=OLGA_CLOSEDOC;
        appl_write(pipe[1],16,@answ)
    end;


procedure OLGALink(const pipe: ARRAY_8);
    var answ  : ARRAY_8;
        found : boolean;
        pdocd : PDocument;
        pl,pld: PLink;
        pc    : PChar;

    begin
        {$IFDEF DEBUG}
        writeln('OLGA: OLGA_LINK App ',pipe[1],' Gruppe ',pipe[5],'  ',PChar(Ptr(word(pipe[3]),word(pipe[4]))));
        {$ENDIF}
        found:=false;
        pdocd:=Docs;
        while pdocd<>nil do
            with pdocd^ do
                begin
                    if apID=pipe[1] then
                        begin
                            found:=true;
                            break
                        end;
                    pdocd:=Next
                end;
        if not(found) then OpenDoc(pipe);
        if (pipe[3]=0) and (pipe[4]=0) then answ[6]:=0
        else
            begin
                new(pl);
                if pl<>nil then
                    begin
                        pl^.apID:=pipe[1];
                        pl^.Group:=pipe[5];
                        pc:=PChar(Ptr(word(pipe[3]),word(pipe[4])));
                        GlobalAlloc(pl^.Path,StrLen(pc)+1);
                        if pl^.Path=nil then
                            begin
                                dispose(pl);
                                answ[6]:=0
                            end
                        else
                            begin
                                StrCopy(pl^.Path,pc);
                                pl^.Prev:=nil;
                                pl^.Next:=nil;
                                if Links=nil then Links:=pl
                                else
                                    begin
                                        pld:=Links;
                                        while pld^.Next<>nil do pld:=pld^.Next;
                                        pld^.Next:=pl;
                                        pl^.Prev:=pld
                                    end;
                                answ[6]:=1;
                                inc(LinkCount)
                            end
                    end
                else
                    answ[6]:=0
            end;
        answ[0]:=OLGA_ACK;
        answ[1]:=apID;
        answ[2]:=0;
        answ[3]:=pipe[3];
        answ[4]:=pipe[4];
        answ[5]:=pipe[5];
        answ[7]:=OLGA_LINK;
        appl_write(pipe[1],16,@answ)
    end;


procedure OLGAUnlink(const pipe: ARRAY_8);
    var answ: ARRAY_8;

    begin
        {$IFDEF DEBUG}
        writeln('OLGA: OLGA_UNLINK App ',pipe[1],' Gruppe ',pipe[5],'  ',PChar(Ptr(word(pipe[3]),word(pipe[4]))));
        {$ENDIF}
        answ[6]:=Unlink(true,true,pipe);
        answ[0]:=OLGA_ACK;
        answ[1]:=apID;
        answ[2]:=0;
        answ[3]:=pipe[3];
        answ[4]:=pipe[4];
        answ[5]:=pipe[5];
        answ[7]:=OLGA_UNLINK;
        appl_write(pipe[1],16,@answ)
    end;


procedure OLGABreakLink(const pipe: ARRAY_8);
    var answ: ARRAY_8;
        pld : PLink;
        pc  : PChar;

    begin
        {$IFDEF DEBUG}
        writeln('OLGA: OLGA_BREAKLINK App ',pipe[1],'  ',PChar(Ptr(word(pipe[3]),word(pipe[4]))));
        {$ENDIF}
        pld:=Links;
        answ[0]:=OLGA_LINKBROKEN;
        answ[1]:=apID;
        answ[2]:=0;
        answ[6]:=0;
        answ[7]:=0;
        pc:=PChar(Ptr(word(pipe[3]),word(pipe[4])));
        while pld<>nil do
            with pld^ do
                begin
                    if StrIComp(pc,Path)=0 then
                        begin
                            {$IFDEF DEBUG}
                            writeln('      LinkBroken an App ',apID,' Gruppe ',Group);
                            {$ENDIF}
                            answ[3]:=integer(HiWord(Path));
                            answ[4]:=integer(LoWord(Path));
                            answ[5]:=Group;
                            appl_write(apID,16,@answ)
                        end;
                    pld:=Next
                end;
        answ[0]:=OLGA_ACK;
        answ[3]:=pipe[3];
        answ[4]:=pipe[4];
        answ[5]:=0;
        answ[7]:=OLGA_BREAKLINK;
        appl_write(pipe[1],16,@answ)
    end;


procedure OLGAStart(const pipe: ARRAY_8);
    label _started;

    var answ     : ARRAY_8;
        pa       : PApp;
        pt       : PType;
        pe       : PExtension;
        tmp_drive,
        stid     : integer;
        dummy,
        stname,
        tmp_cwd,
        fname    : string;

    begin
        {$IFDEF DEBUG}
        write('OLGA: OLGA_START App ',pipe[1],'  ');
        case pipe[3] of
        OLS_TYPE:
            write('OLS_TYPE ',chr(hi(pipe[5])),chr(lo(pipe[5])));
        OLS_EXTENSION:
            write('OLS_EXTENSION ',chr(hi(pipe[4])),chr(lo(pipe[4])),chr(hi(pipe[5])),chr(lo(pipe[5])));
        OLS_NAME:
            write('OLS_NAME ',PChar(Ptr(word(pipe[4]),word(pipe[5]))));
        end;
        if (pipe[6]<>0) or (pipe[7]<>0) then writeln('  Cmd ',PChar(Ptr(word(pipe[6]),word(pipe[7]))))
        else
            writeln;
        {$ENDIF}
        answ[6]:=0;
        pa:=Apps;
        while pa<>nil do
            with pa^ do
                begin
                    if apID=pipe[1] then break;
                    pa:=Next
                end;
        if pa=nil then goto _started;
        fname:='';
        case pipe[3] of
        OLS_TYPE:
            begin
                pt:=Types;
                while pt<>nil do
                    with pt^ do
                        begin
                            if typ=pipe[5] then
                                begin
                                    fname:=ExpandPath(path);
                                    break
                                end;
                            pt:=next
                        end
            end;
        OLS_EXTENSION:
            begin
                pe:=Extensions;
                while pe<>nil do
                    with pe^ do
                        begin
                            if ext4=pipe[4] then
                                if ext5=pipe[5] then
                                    begin
                                        fname:=ExpandPath(path);
                                        break
                                    end;
                            pe:=next
                        end
            end;
        OLS_NAME:
            fname:=StrPPas(Ptr(word(pipe[4]),word(pipe[5])))
        end;
        if length(fname)=0 then goto _started;
        inc(pa^.CmdCount);
        if pa^.CmdCount>CMDMAX then pa^.CmdCount:=0;
        if pa^.StartCmd[pa^.CmdCount]<>nil then GlobalFree(pa^.StartCmd[pa^.CmdCount],pa^.CmdLen[pa^.CmdCount]);
        pa^.CmdLen[pa^.CmdCount]:=length(StrPPas(Ptr(word(pipe[6]),word(pipe[7]))))+1;
        fsplit(fname,dummy,stname,tmp_cwd);
        while length(stname)<8 do stname:=stname+' ';
        for stid:=1 to 8 do stname[stid]:=upcase(stname[stid]);
        stid:=appl_find(stname);
        if stid>=0 then
            begin
                GlobalAlloc(pa^.StartCmd[pa^.CmdCount],pa^.CmdLen[pa^.CmdCount]);
                if pa^.StartCmd[pa^.CmdCount]=nil then goto _started;
                StrPCopy(pa^.StartCmd[pa^.CmdCount],StrPPas(Ptr(word(pipe[6]),word(pipe[7]))));
                answ[0]:=VA_START;
                answ[1]:=apID;
                answ[2]:=0;
                answ[3]:=integer(HiWord(pa^.StartCmd[pa^.CmdCount]));
                answ[4]:=integer(LoWord(pa^.StartCmd[pa^.CmdCount]));
                answ[5]:=0;
                answ[6]:=0;
                answ[7]:=0;
                appl_write(stid,16,@answ);
                answ[6]:=1;
                if (pipe[3]=OLS_TYPE) or (pipe[3]=OLS_EXTENSION) then ServerStarted(stid,pipe[1],pipe[4],pipe[5])
                else
                    ServerStarted(stid,pipe[1],0,0)
            end
        else
            if MultiTOS or MagiX then
                begin
                    inc(pa^.CmdLen[pa^.CmdCount]);
                    GlobalAlloc(pa^.StartCmd[pa^.CmdCount],pa^.CmdLen[pa^.CmdCount]);
                    if pa^.StartCmd[pa^.CmdCount]=nil then goto _started;
                    PChar(pa^.StartCmd[pa^.CmdCount])^:=chr(pa^.CmdLen[pa^.CmdCount]-2);
                    StrPCopy(PChar(longint(pa^.StartCmd[pa^.CmdCount])+1),StrPPas(Ptr(word(pipe[6]),word(pipe[7]))));
                    fname:=fname+#0;
                    tmp_drive:=dgetdrv;
                    dgetpath(tmp_cwd,tmp_drive+1);
                    if length(fname)>1 then
                        if fname[2]=':' then dsetdrv(ord(upcase(fname[1]))-65);
                    dsetpath(dummy+#0);
                    if MultiTOS then answ[6]:=ShelWrite(0,1,1,@fname[1],pa^.StartCmd[pa^.CmdCount])
                    else
                        answ[6]:=ShelWrite(1,1,100,@fname[1],pa^.StartCmd[pa^.CmdCount]);
                    if answ[6]=0 then
                        begin
                            dsetdrv(tmp_drive);
                            dsetpath(tmp_cwd)
                        end
                    else
                        begin
                            if (pipe[3]=OLS_TYPE) or (pipe[3]=OLS_EXTENSION) then ServerStarted(AES_pb.intout^[0],pipe[1],pipe[4],pipe[5])
                            else
                                ServerStarted(AES_pb.intout^[0],pipe[1],0,0)
                        end
                end;
        _started:
        answ[0]:=OLGA_ACK;
        answ[1]:=apID;
        answ[2]:=0;
        answ[3]:=pipe[3];
        answ[4]:=pipe[4];
        answ[5]:=pipe[5];
        answ[7]:=OLGA_START;
        appl_write(pipe[1],16,@answ);
        if (pipe[6]<>0) or (pipe[7]<>0) then
            begin
                answ[3]:=0;
                answ[4]:=pipe[6];
                answ[5]:=pipe[7];
                appl_write(pipe[1],16,@answ)
            end
    end;


procedure OLGAGetObjects(const pipe: ARRAY_8);
    var pa,pad: PApp;
        answ  : ARRAY_8;
        pod   : PObject;

    begin
        {$IFDEF DEBUG}
        write('OLGA: OLGA_GETOBJECTS App ',pipe[1],'  ');
        if pipe[3]=0 then write('first  (')
        else
            write('next  (');
        {$ENDIF}
        pa:=nil;
        pad:=Apps;
        while pad<>nil do
            begin
                if pad^.apID=pipe[1] then
                    begin
                        pa:=pad;
                        break
                    end;
                pad:=pad^.Next
            end;
        if pa<>nil then
            begin
                if pipe[3]=0 then pa^.enumOLE:=Objects;
                if pa^.enumOLE<>nil then
                    begin
                        answ[0]:=OLGA_OBJECTS;
                        answ[1]:=apID;
                        answ[2]:=0;
                        answ[3]:=0;
                        answ[4]:=pa^.enumOLE^.ext4;
                        answ[5]:=pa^.enumOLE^.ext5;
                        answ[6]:=integer(HiWord(pa^.enumOLE^.Descr));
                        answ[7]:=integer(LoWord(pa^.enumOLE^.Descr));
                        pod:=pa^.enumOLE^.Next;
                        while pod<>nil do
                            begin
                                inc(answ[3]);
                                pod:=pod^.Next
                            end;
                        {$IFDEF DEBUG}
                        write(answ[3],',',PChar(pa^.enumOLE^.Descr));
                        {$ENDIF}
                        appl_write(pipe[1],16,@answ);
                        pa^.enumOLE:=pa^.enumOLE^.Next
                    end
            end;
        {$IFDEF DEBUG}
        writeln(')')
        {$ENDIF}
    end;


procedure OLGAIdle(const pipe: ARRAY_8);
    var answ: ARRAY_8;

    begin
        {$IFDEF DEBUG}
        write('OLGA: OLGA_IDLE App ',pipe[1],' (');
        if pipe[3]=0 then writeln('reply)')
        else
            writeln('request) -> reply');
        {$ENDIF}
        if pipe[3]<>0 then
            begin
                answ[0]:=OLGA_IDLE;
                answ[1]:=apID;
                answ[2]:=0;
                answ[3]:=0;
                answ[4]:=pipe[4];
                answ[5]:=pipe[5];
                answ[6]:=pipe[6];
                answ[7]:=pipe[7];
                appl_write(pipe[1],16,@answ)
            end
    end;


procedure OLGAActivate(const pipe: ARRAY_8);
    label _raus;

    var answ     : ARRAY_8;
        e4,e5,q,
        tmp_drive,
        anz      : integer;
        pc       : PChar;
        pe       : PExtension;
        tmp_cwd,
        afind,
        dummy,
        fname    : string;

    begin
        anz:=pipe[5];
        pc:=PChar(Ptr(word(pipe[3]),word(pipe[4])));
        {$IFDEF DEBUG}
        write('OLGA: OLGA_ACTIVATE App ',pipe[1],'  #',anz);
        if (anz<1) or (pc=nil) then writeln
        else
            begin
                write(' (');
                for q:=0 to (anz shl 2)-1 do write(PChar(longint(pc)+q)^);
                writeln(')')
            end;
        {$ENDIF}
        if anz<1 then goto _raus;
        if pc=nil then goto _raus;
        repeat
            e4:=ord(pc^);
            inc(longint(pc));
            e4:=(e4 shl 8) or ord(pc^);
            inc(longint(pc));
            e5:=ord(pc^);
            inc(longint(pc));
            e5:=(e5 shl 8) or ord(pc^);
            inc(longint(pc));
            pe:=Extensions;
            fname:='';
            while pe<>nil do
                with pe^ do
                    begin
                        if ext4=e4 then
                            if ext5=e5 then
                                begin
                                    fname:=ExpandPath(path);
                                    break
                                end;
                        pe:=next
                    end;
            if length(fname)>0 then
                begin
                    fsplit(fname,dummy,afind,tmp_cwd);
                    while length(afind)<8 do afind:=afind+' ';
                    for q:=1 to 8 do afind[q]:=upcase(afind[q]);
                    q:=appl_find(afind);
                    if q>=0 then ServerStarted(q,pipe[1],e4,e5)
                    else
                        begin
                            {$IFDEF DEBUG}
                            writeln('  ...starting ',fname,' (',chr((e4 shr 8) and $00ff),chr(e4 and $00ff),chr((e5 shr 8) and $00ff),chr(e5 and $00ff),')');
                            {$ENDIF}
                            fname:=fname+#0;
                            tmp_drive:=dgetdrv;
                            dgetpath(tmp_cwd,tmp_drive+1);
                            if length(fname)>1 then
                                if fname[2]=':' then dsetdrv(ord(upcase(fname[1]))-65);
                            dsetpath(dummy+#0);
                            if MultiTOS then answ[6]:=ShelWrite(0,1,1,@fname[1],empty)
                            else
                                answ[6]:=ShelWrite(1,1,100,@fname[1],empty);
                            if answ[6]<>0 then
                                begin
                                    ServerStarted(AES_pb.intout^[0],pipe[1],e4,e5);
                                    evnt_timer(1500,0)
                                end
                            else
                                begin
                                    dsetdrv(tmp_drive);
                                    dsetpath(tmp_cwd)
                                end
                        end
                end;
            dec(anz)
        until anz<=0;
        _raus:
        answ[0]:=OLGA_ACK;
        answ[1]:=apID;
        answ[2]:=0;
        answ[3]:=pipe[3];
        answ[4]:=pipe[4];
        answ[5]:=pipe[5];
        answ[6]:=0;
        answ[7]:=OLGA_ACTIVATE;
        appl_write(pipe[1],16,@answ)
    end;


procedure OLGAEmbed(const pipe: ARRAY_8);
    var tmp_cwd,
        afind,
        dummy,
        fname  : string;
        answ   : ARRAY_8;
        pe     : PExtension;
        q      : integer;

    begin
        {$IFDEF DEBUG}
        write('OLGA: OLGA_EMBED App ',pipe[1],' (',chr(hi(pipe[6])),chr(lo(pipe[6])),chr(hi(pipe[7])),chr(lo(pipe[7])),')  ');
        {$ENDIF}
        pe:=Extensions;
        fname:='';
        while pe<>nil do
            with pe^ do
                begin
                    if ext4=pipe[6] then
                        if ext5=pipe[7] then
                            begin
                                fname:=ExpandPath(path);
                                break
                            end;
                    pe:=next
                end;
        if length(fname)=0 then q:=-1
        else
            begin
                fsplit(fname,dummy,afind,tmp_cwd);
                while length(afind)<8 do afind:=afind+' ';
                for q:=1 to 8 do afind[q]:=upcase(afind[q]);
                q:=appl_find(afind)
            end;
        if q<0 then
            begin
                {$IFDEF DEBUG}
                write('error: ');
                if length(fname)=0 then writeln('extension not assigned')
                else
                    writeln('server not running');
                {$ENDIF}
                answ[0]:=OLGA_EMBEDDED;
                answ[1]:=apID;
                answ[2]:=0;
                answ[3]:=pipe[3];
                answ[4]:=pipe[4];
                answ[5]:=pipe[5];
                answ[6]:=0;
                answ[7]:=0;
                appl_write(pipe[1],16,@answ)
            end
        else
            begin
                {$IFDEF DEBUG}
                writeln('calling server ',q);
                {$ENDIF}
                answ[0]:=OLGA_EMBED;
                answ[1]:=apID;
                answ[2]:=0;
                answ[3]:=pipe[3];
                answ[4]:=pipe[4];
                answ[5]:=pipe[5];
                answ[6]:=0;
                answ[7]:=pipe[1];
                appl_write(q,16,@answ)
            end
    end;


procedure OLGARequestNotification(const pipe: ARRAY_8);
    var pn,pnd: PNote;

    begin
        new(pn);
        if pn<>nil then
            begin
                Denotify(pipe[1],pipe[3],pipe[4]);
                pn^.apID:=pipe[1];
                pn^.ext4:=pipe[3];
                pn^.ext5:=pipe[4];
                pn^.Prev:=nil;
                pn^.Next:=nil;
                if Notes=nil then Notes:=pn
                else
                    begin
                        pnd:=Notes;
                        while pnd^.Next<>nil do pnd:=pnd^.Next;
                        pnd^.Next:=pn;
                        pn^.Prev:=pnd
                    end
            end
    end;


procedure OLGAReleaseNotification(const pipe: ARRAY_8);

    begin
        {$IFDEF DEBUG}
        write('OLGA: OLGA_RELEASENOTIFICATION App ',pipe[1],' (');
        if (pipe[3]=0) and (pipe[4]=0) then writeln('all)')
        else
            writeln(chr((pipe[3] shr 8) and $00ff),chr(pipe[3] and $00ff),chr((pipe[4] shr 8) and $00ff),chr(pipe[4] and $00ff),')');
        {$ENDIF}
        Denotify(pipe[1],pipe[3],pipe[4])
    end;


procedure OLGANotified(const pipe: ARRAY_8);
    var p: pointer;

    begin
        p:=Ptr(word(pipe[3]),word(pipe[4]));
        {$IFDEF DEBUG}
        writeln('OLGA: OLGA_NOTIFIED App ',pipe[1],'  ',PChar(p));
        {$ENDIF}
        GlobalFree(p,StrLen(p)+1)
    end;


procedure OLGAGetSettings(const pipe: ARRAY_8);
    var answ: ARRAY_8;

    begin
        {$IFDEF DEBUG}
        writeln('OLGA: OLGA_GETSETTINGS App ',pipe[1]);
        {$ENDIF}
        answ[0]:=OLGA_SETTINGS;
        answ[1]:=apID;
        answ[2]:=0;
        answ[3]:=0;
        answ[4]:=0;
        answ[5]:=0;
        answ[6]:=0;
        answ[7]:=0;
        appl_write(pipe[1],16,@answ)
    end;


procedure CHExit(const pipe: ARRAY_8);

    begin
        {$IFDEF DEBUG}
        writeln('OLGA: CH_EXIT App ',pipe[1],'  Child ',pipe[3],' Code ',pipe[4]);
        {$ENDIF}
        ServerTerminated(pipe[3],pipe[4])
    end;


function AVPathUpdate(var pipe: ARRAY_8): boolean;
    var pad: PApp;

    begin
        AVPathUpdate:=false;
        pad:=Apps;
        while pad<>nil do
            with pad^ do
                begin
                    if apID=pipe[1] then
                        begin
                            if not(bTst(Flags,OL_SERVER)) then
                                begin
                                    pipe[0]:=OLGA_UPDATE;
                                    AVPathUpdate:=true
                                end;
                            break
                        end;
                    pad:=Next
                end
    end;


procedure MUKeybd(kstat,key: integer);
    var answ: ARRAY_8;
        q   : integer;

    begin
        if not(mbar) then exit;
        q:=menu_bar(nil,-1);
        {$IFDEF DEBUG}
        writeln('OLGA: AV_SENDKEY Stat ',kstat,' Key ',key,' -> App #',q);
        {$ENDIF}
        answ[0]:=AV_SENDKEY;
        answ[1]:=apID;
        answ[2]:=0;
        answ[3]:=kstat;
        answ[4]:=key;
        answ[5]:=0;
        answ[6]:=0;
        answ[7]:=0;
        appl_write(q,16,@answ)
    end;


procedure InitManager;
    var cookiejar: PCookie;
        tmp_drive,
        event,
        stid,
        mgxver   : integer;
        answ     : ARRAY_8;
        search,
        shutdown,
        broadcast: boolean;
        dummy,
        fname    : string;
        f        : text;

    procedure read_inf;
        var pal,pald : PAlias;
            pt,ptd   : PType;
            po,pod   : PObject;
            pe,ped   : PExtension;
            tmp_drive,
            stid,q   : integer;
            keyname,
            dummy    : string;

        begin
            while not(eof(f)) do
                begin
                    readln(f,dummy);
                    {$IFDEF DEBUG}
                    writeln('|',dummy,'|');
                    {$ENDIF}
                    if length(dummy)>0 then
                        if dummy[1]<>';' then
                            begin
                                if dummy[1]='[' then
                                    begin
                                        if dummy='[Extensions]' then stid:=1
                                        else if dummy='[Types]' then stid:=2
                                        else if dummy='[Applications]' then stid:=3
                                        else if dummy='[Objects]' then stid:=4
                                        else stid:=0
                                    end
                                else
                                    case stid of
                                    1:
                                        begin
                                            new(pe);
                                            if pe=nil then continue;
                                            tmp_drive:=pos('=',dummy);
                                            pe^.ext4:=integer((ord(dummy[1]) shl 8) or ord(dummy[2]));
                                            if tmp_drive=3 then pe^.ext5:=0
                                            else
                                                if tmp_drive=4 then pe^.ext5:=integer((ord(dummy[3]) shl 8))
                                                else
                                                    pe^.ext5:=integer((ord(dummy[3]) shl 8) or ord(dummy[4]));
                                            pe^.path:=copy(dummy,tmp_drive+1,length(dummy)-tmp_drive);
                                            pe^.next:=nil;
                                            if Extensions=nil then Extensions:=pe
                                            else
                                                begin
                                                    ped:=Extensions;
                                                    while ped^.next<>nil do ped:=ped^.next;
                                                    ped^.next:=pe
                                                end
                                        end;
                                    2:
                                        begin
                                            new(pt);
                                            if pt=nil then continue;
                                            pt^.typ:=integer((ord(dummy[1]) shl 8) or ord(dummy[2]));
                                            pt^.path:=copy(dummy,4,length(dummy)-3);
                                            pt^.next:=nil;
                                            if Types=nil then Types:=pt
                                            else
                                                begin
                                                    ptd:=Types;
                                                    while ptd^.next<>nil do ptd:=ptd^.next;
                                                    ptd^.next:=pt
                                                end
                                        end;
                                    3:
                                        begin
                                            new(pal);
                                            if pal=nil then continue;
                                            tmp_drive:=pos('=',dummy);
                                            pal^.alias:=copy(dummy,1,tmp_drive-1);
                                            pal^.path:=copy(dummy,tmp_drive+1,length(dummy)-tmp_drive);
                                            pal^.next:=nil;
                                            if Aliases=nil then Aliases:=pal
                                            else
                                                begin
                                                    pald:=Aliases;
                                                    while pald^.next<>nil do pald:=pald^.next;
                                                    pald^.next:=pal
                                                end
                                        end;
                                    4:
                                        begin
                                            new(po);
                                            if po=nil then continue;
                                            tmp_drive:=pos('=',dummy);
                                            po^.ext4:=integer((ord(dummy[1]) shl 8) or ord(dummy[2]));
                                            if tmp_drive=3 then po^.ext5:=0
                                            else
                                                if tmp_drive=4 then po^.ext5:=integer((ord(dummy[3]) shl 8))
                                                else
                                                    po^.ext5:=integer((ord(dummy[3]) shl 8) or ord(dummy[4]));
                                            GlobalAlloc(po^.Descr,length(dummy)+1-tmp_drive);
                                            if po^.Descr=nil then continue;
                                            StrPCopy(po^.Descr,copy(dummy,tmp_drive+1,length(dummy)-tmp_drive));
                                            po^.next:=nil;
                                            if Objects=nil then Objects:=po
                                            else
                                                begin
                                                    pod:=Objects;
                                                    while pod^.next<>nil do pod:=pod^.next;
                                                    pod^.next:=po
                                                end
                                        end
                                    end
                            end
                end;
            close(f)
        end;

    function BootDevice: char;

        begin
            BootDevice:=chr(supexec(bootdev))
        end;

    begin
        {$IFDEF DEBUG}
        writeln('OLGA aktiviert...');
        {$ENDIF}
        HeapError:=@HeapFunc;
        MemProt:=false;
        MagiX:=false;
        mgxver:=0;
      cookiejar:=PCookie(supexec(getjar));
      if cookiejar<>nil then
            while PLongint(cookiejar)^<>0 do
                with cookiejar^ do
                    begin
                        if ID='MiNT' then MemProt:=true
                        else
                            if ID='MagX' then
                                begin
                                    MagiX:=true;
                                    if Val<>0 then
                                        with PMAGX_COOKIE(Val)^ do
                                            if aes_vars<>nil then
                                                with aes_vars^ do
                                                    if (magic=-2023406815) and (magic2='MAGX') then mgxver:=version;
                                    if mgxver>=$0200 then MemProt:=true
                                end;
                        inc(longint(cookiejar),8)
                    end;
        GEM_pb.global[0]:=0;
        apID:=appl_init;
        if GEM_pb.global[0]=0 then halt;
      if apID<0 then halt;
      wind_update(BEG_UPDATE);
        if shel_read(fname,dummy)=0 then fname:='';
        getmem(apName,length(fname)+1);
        if apName<>nil then StrPCopy(apName,fname);
        MultiTOS:=(GEM_pb.global[0]>=$0400) and (GEM_pb.global[1]=-1);
        Multitask:=(GEM_pb.global[1]<>1);
        has_agi:=(GEM_pb.global[0]>=$0400);
        if not(has_agi) then has_agi:=(mgxver>=$0200);
        if not(has_agi) then has_agi:=(appl_find('?AGI'#0#0#0#0)=0);
        if not(has_agi) then has_agi:=(wind_get(0,WF_WINX,stid,stid,stid,stid)=WF_WINX);
        if appl_xgetinfo(10,event,stid,stid,stid) then
            begin
                shutdown:=((event and $00ff)>=9) or (mgxver>=$0300);
                broadcast:=((event and $00ff)>=7) and not(MagiX)
            end
        else
            begin
                shutdown:=(GEM_pb.global[0]>=$0400);
                broadcast:=shutdown
            end;
        if appl_xgetinfo(4,stid,stid,event,stid) then search:=(event=1)
        else
            search:=(GEM_pb.global[0]>=$0400);
        if appl_xgetinfo(6,stid,stid,event,stid) then mbar:=(event=1)
        else
            mbar:=false;
        Links:=nil;
        Apps:=nil;
        Docs:=nil;
        if not(AppFlag) or MultiTOS then
            begin
                menuID:=menu_register(apID,'  OLGA-Manager ');
                if menuID<0 then
                    begin
                        wind_update(END_UPDATE);
                        {$IFDEF DEBUG}
                        writeln('... OLGA deaktiviert.');
                        {$ENDIF}
                        if MultiTOS then
                            begin
                                appl_exit;
                                halt
                            end
                        else
                            repeat
                                evnt_timer(0,1)
                            until false
                    end;
            end;
        LinkCount:=0;
        AppCount:=0;
        DocCount:=0;
        Types:=nil;
        Extensions:=nil;
        Aliases:=nil;
        Objects:=nil;
        Notes:=nil;
        Server:=nil;
        Clients:=nil;
        GlobalAlloc(empty,16);
        if empty<>nil then PChar(empty)^:=#0;
        stid:=0;
        dummy:=getenv('HOME');
        if length(dummy)>0 then
            begin
                if dummy[length(dummy)]<>'\' then dummy:=dummy+'\';
                {$IFDEF DEBUG}
                writeln(dummy+'defaults\olga.inf (?)');
                {$ENDIF}
                assign(f,dummy+'defaults\olga.inf');
                reset(f);
                if ioresult=0 then read_inf
                else
                    begin
                        {$IFDEF DEBUG}
                        writeln(dummy+'olga.inf (?)');
                        {$ENDIF}
                        assign(f,dummy+'olga.inf');
                        reset(f);
                        if ioresult=0 then read_inf
                        else
                            begin
                                {$IFDEF DEBUG}
                                writeln(BootDevice+':\olga.inf (?)');
                                {$ENDIF}
                                assign(f,BootDevice+':\olga.inf');
                                reset(f);
                                if ioresult=0 then read_inf
                                else
                                    begin
                                        {$IFDEF DEBUG}
                                        writeln('olga.inf (?)');
                                        {$ENDIF}
                                        assign(f,'olga.inf');
                                        reset(f);
                                        if ioresult=0 then read_inf
                                    end
                            end
                    end
            end
        else
            begin
                {$IFDEF DEBUG}
                writeln(BootDevice+':\olga.inf (?)');
                {$ENDIF}
                assign(f,BootDevice+':\olga.inf');
                reset(f);
                if ioresult=0 then read_inf
                else
                    begin
                        {$IFDEF DEBUG}
                        writeln('olga.inf (?)');
                        {$ENDIF}
                        assign(f,'olga.inf');
                        reset(f);
                        if ioresult=0 then read_inf
                    end
            end;
        {$IFDEF DEBUG}
        writeln;
        {$ENDIF}
        termflag:=false;
        wind_update(END_UPDATE);
        Psignal(SIGTERM,@SigHandler);
        Psignal(SIGQUIT,@SigHandler);
        if not(Multitask) then
            begin
                form_alert(1,'[0][OLGA v'+OLGAVersionStr+'  Rev '+OLGARevision+' ('+OLGADate+') | |Bitte unter einem|Multitasking-Betriebssystem|verwenden.][   OK   ]');
                if AppFlag then
                    begin
                        {$IFDEF DEBUG}
                        writeln('... OLGA deaktiviert.');
                        {$ENDIF}
                        appl_exit;
                        halt
                    end
            end;
        if shutdown then ShelWrite(9,1,0,nil,nil);
        answ[0]:=OLE_NEW;
        answ[1]:=apID;
        answ[2]:=0;
        answ[3]:=OLGAFlags;
        answ[4]:=OLGAProtocol;
        answ[5]:=0;
        answ[6]:=0;
        answ[7]:=OLGAVersion;
        if broadcast then
            begin
                with AES_pb do
                    begin
                        control^[0]:=121;
                        control^[1]:=3;
                        control^[2]:=1;
                        control^[3]:=2;
                        control^[4]:=0;
                        intin^[0]:=7;
                        intin^[1]:=0;
                        intin^[2]:=0;
                        addrin^[0]:=@answ;
                        addrin^[1]:=nil
                    end;
                _crystal(@AES_pb)
            end
        else
            if search then
                begin
                    stid:=appl_search(0,dummy,tmp_drive,event);
                    while stid=1 do
                        begin
                            if (tmp_drive<>1) and (event<>apID) then appl_write(event,16,@answ);
                            stid:=appl_search(1,dummy,tmp_drive,event)
                        end
                end
    end;


procedure EventLoop;
    label _again;

    var dummy,
        event,
        kstat,
        key  : integer;
        pipe : ARRAY_8;

    begin
        repeat
            event:=evnt_multi(MU_MESAG or MU_TIMER or MU_KEYBD,0,0,0,0,0,0,0,0,0,0,0,0,0,pipe,1000,0,dummy,dummy,dummy,kstat,key,dummy);
            _again:
            if bTst(event,MU_MESAG) then
                case pipe[0] of
                AC_OPEN:
                    form_alert(1,'[0][OLGA v'+OLGAVersionStr+'  Rev '+OLGARevision+' ('+OLGADate+') |    by [e-mail]|'+ltoa(AppCount)+' OLGA-Application(s)|'+ltoa(DocCount)+' Document(s)|'+ltoa(LinkCount)+' Link(s)][   OK   ]');
                AP_TERM:
                    termflag:=true;
                AV_PATH_UPDATE:
                    if AVPathUpdate(pipe) then goto _again;
                OLE_INIT:
                    OLEInit(pipe);
                OLE_EXIT:
                    OLEExit(pipe);
                OLGA_UPDATE:
                    OLGAUpdate(pipe);
                OLGA_RENAME:
                    OLGARename(pipe);
                OLGA_LINKRENAMED:
                    OLGALinkRenamed(pipe);
                OLGA_OPENDOC:
                    OLGAOpenDoc(pipe);
                OLGA_CLOSEDOC:
                    OLGACloseDoc(pipe);
                OLGA_LINK:
                    OLGALink(pipe);
                OLGA_UNLINK:
                    OLGAUnlink(pipe);
                OLGA_BREAKLINK:
                    OLGABreakLink(pipe);
                OLGA_START:
                    OLGAStart(pipe);
                OLGA_GETOBJECTS:
                    OLGAGetObjects(pipe);
                OLGA_IDLE:
                    OLGAIdle(pipe);
                OLGA_ACTIVATE:
                    OLGAActivate(pipe);
                OLGA_EMBED:
                    OLGAEmbed(pipe);
                OLGA_REQUESTNOTIFICATION:
                    OLGARequestNotification(pipe);
                OLGA_RELEASENOTIFICATION:
                    OLGAReleaseNotification(pipe);
                OLGA_NOTIFIED:
                    OLGANotified(pipe);
                OLGA_GETSETTINGS:
                    OLGAGetSettings(pipe);
                CH_EXIT:
                    CHExit(pipe)
                end;
            if bTst(event,MU_KEYBD) then MUKeybd(kstat,key)
        until termflag
    end;


procedure ExitManager;
    var answ: ARRAY_8;
        pad : PApp;

    begin
        {$IFDEF DEBUG}
        writeln('... OLGA deaktiviert.');
        {$ENDIF}
        answ[0]:=OLE_EXIT;
        answ[1]:=apID;
        answ[2]:=0;
        answ[3]:=0;
        answ[4]:=0;
        answ[5]:=0;
        answ[6]:=0;
        answ[7]:=0;
        pad:=Apps;
        while pad<>nil do
            begin
                appl_write(pad^.apID,16,@answ);
                pad:=pad^.Next
            end;
        appl_exit
    end;


begin
    InitManager;
    EventLoop;
    ExitManager
end.